home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / blas / dznrm2.f < prev    next >
Text File  |  1997-01-29  |  2KB  |  68 lines
  1.       DOUBLE PRECISION FUNCTION DZNRM2( N, X, INCX )
  2. *     .. Scalar Arguments ..
  3.       INTEGER                           INCX, N
  4. *     .. Array Arguments ..
  5.       COMPLEX*16                        X( * )
  6. *     ..
  7. *
  8. *  DZNRM2 returns the euclidean norm of a vector via the function
  9. *  name, so that
  10. *
  11. *     DZNRM2 := sqrt( conjg( x' )*x )
  12. *
  13. *
  14. *
  15. *  -- This version written on 25-October-1982.
  16. *     Modified on 14-October-1993 to inline the call to ZLASSQ.
  17. *     Sven Hammarling, Nag Ltd.
  18. *
  19. *
  20. *     .. Parameters ..
  21.       DOUBLE PRECISION      ONE         , ZERO
  22.       PARAMETER           ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  23. *     .. Local Scalars ..
  24.       INTEGER               IX
  25.       DOUBLE PRECISION      NORM, SCALE, SSQ, TEMP
  26. *     .. Intrinsic Functions ..
  27.       INTRINSIC             ABS, DIMAG, DBLE, SQRT
  28. *     ..
  29. *     .. Executable Statements ..
  30.       IF( N.LT.1 .OR. INCX.LT.1 )THEN
  31.          NORM  = ZERO
  32.       ELSE
  33.          SCALE = ZERO
  34.          SSQ   = ONE
  35. *        The following loop is equivalent to this call to the LAPACK
  36. *        auxiliary routine:
  37. *        CALL ZLASSQ( N, X, INCX, SCALE, SSQ )
  38. *
  39.          DO 10, IX = 1, 1 + ( N - 1 )*INCX, INCX
  40.             IF( DBLE( X( IX ) ).NE.ZERO )THEN
  41.                TEMP = ABS( DBLE( X( IX ) ) )
  42.                IF( SCALE.LT.TEMP )THEN
  43.                   SSQ   = ONE   + SSQ*( SCALE/TEMP )**2
  44.                   SCALE = TEMP
  45.                ELSE
  46.                   SSQ   = SSQ   +     ( TEMP/SCALE )**2
  47.                END IF
  48.             END IF
  49.             IF( DIMAG( X( IX ) ).NE.ZERO )THEN
  50.                TEMP = ABS( DIMAG( X( IX ) ) )
  51.                IF( SCALE.LT.TEMP )THEN
  52.                   SSQ   = ONE   + SSQ*( SCALE/TEMP )**2
  53.                   SCALE = TEMP
  54.                ELSE
  55.                   SSQ   = SSQ   +     ( TEMP/SCALE )**2
  56.                END IF
  57.             END IF
  58.    10    CONTINUE
  59.          NORM  = SCALE * SQRT( SSQ )
  60.       END IF
  61. *
  62.       DZNRM2 = NORM
  63.       RETURN
  64. *
  65. *     End of DZNRM2.
  66. *
  67.       END
  68.